home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue63 / Docking / DockedControls10U.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-09-19  |  4.0 KB  |  138 lines
  1. unit DockedControls10U;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ActnList, Menus, ImgList, ComCtrls, ExtCtrls, ToolWin, StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     ImageList1: TImageList;
  12.     Label1: TLabel;
  13.     MainMenu1: TMainMenu;
  14.     ActionList1: TActionList;
  15.     actToggleToolbar: TAction;
  16.     Environment1: TMenuItem;
  17.     Toolbarvisible1: TMenuItem;
  18.     btnToggleFloat: TButton;
  19.     ControlBar1: TControlBar;
  20.     PageControl1: TPageControl;
  21.     TabSheet1: TTabSheet;
  22.     Label2: TLabel;
  23.     Image1: TImage;
  24.     ToolBar1: TToolBar;
  25.     ToolButton6: TToolButton;
  26.     ToolButton7: TToolButton;
  27.     ToolButton8: TToolButton;
  28.     ToolButton9: TToolButton;
  29.     ToolButton10: TToolButton;
  30.     procedure FormCreate(Sender: TObject);
  31.     procedure actToggleToolbarExecute(Sender: TObject);
  32.     procedure actToggleToolbarUpdate(Sender: TObject);
  33.     procedure btnToggleFloatClick(Sender: TObject);
  34.     procedure PageControl1DockDrop(Sender: TObject;
  35.       Source: TDragDockObject; X, Y: Integer);
  36.     procedure PageControl1GetSiteInfo(Sender: TObject;
  37.       DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
  38.       var CanDock: Boolean);
  39.     procedure ControlBar1GetSiteInfo(Sender: TObject; DockClient: TControl;
  40.       var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
  41.     procedure ControlBar1DockDrop(Sender: TObject;
  42.       Source: TDragDockObject; X, Y: Integer);
  43.     procedure ControlBar1UnDock(Sender: TObject; Client: TControl;
  44.       NewTarget: TWinControl; var Allow: Boolean);
  45.     procedure ToolBar1StartDock(Sender: TObject;
  46.       var DragObject: TDragDockObject);
  47.     procedure ToolBar1EndDock(Sender, Target: TObject; X, Y: Integer);
  48.   private
  49.     CustomDockObject: TDragDockObject;
  50.   end;
  51.  
  52. var
  53.   Form1: TForm1;
  54.  
  55. implementation
  56.  
  57. {$R *.DFM}
  58.  
  59. procedure TForm1.FormCreate(Sender: TObject);
  60. begin
  61.   Mouse.DragImmediate := False;
  62.   Image1.ManualDock(PageControl1);
  63.   ToolBar1.ManualDock(ControlBar1);
  64. end;
  65.  
  66. procedure TForm1.actToggleToolbarExecute(Sender: TObject);
  67. begin
  68.   ToolBar1.Visible := not (Sender as TAction).Checked
  69. end;
  70.  
  71. procedure TForm1.actToggleToolbarUpdate(Sender: TObject);
  72. begin
  73.   (Sender as TAction).Checked := ToolBar1.Visible
  74. end;
  75.  
  76. procedure TForm1.btnToggleFloatClick(Sender: TObject);
  77. begin
  78.   if ToolBar1.Floating then
  79.     ToolBar1.ManualDock(ControlBar1)
  80.   else
  81.     //ToolBar1.ManualDock(nil)
  82.     ToolBar1.ManualFloat(
  83.       Rect(Left, Top, Left + ToolBar1.UndockWidth, Top + ToolBar1.UndockHeight))
  84. end;
  85.  
  86. procedure TForm1.PageControl1DockDrop(Sender: TObject;
  87.   Source: TDragDockObject; X, Y: Integer);
  88. begin
  89.   if Source.Control = Image1 then
  90.     PageControl1.ActivePage.Caption := 'Athena'
  91. end;
  92.  
  93. procedure TForm1.PageControl1GetSiteInfo(Sender: TObject;
  94.   DockClient: TControl; var InfluenceRect: TRect; MousePos: TPoint;
  95.   var CanDock: Boolean);
  96. begin
  97.   CanDock := not (DockClient is TToolBar)
  98. end;
  99.  
  100. procedure TForm1.ControlBar1GetSiteInfo(Sender: TObject; DockClient: TControl;
  101.   var InfluenceRect: TRect; MousePos: TPoint; var CanDock: Boolean);
  102. begin
  103.   //Only accept toolbars
  104.   CanDock := DockClient is TToolBar
  105. end;
  106.  
  107. procedure TForm1.ControlBar1DockDrop(Sender: TObject;
  108.   Source: TDragDockObject; X, Y: Integer);
  109. begin
  110.   with (Sender as TControlBar) do
  111.     BevelEdges := [beLeft, beRight, beTop, beBottom]
  112. end;
  113.  
  114. procedure TForm1.ControlBar1UnDock(Sender: TObject; Client: TControl;
  115.   NewTarget: TWinControl; var Allow: Boolean);
  116. begin
  117.   with (Sender as TControlBar) do
  118.     //When last control is being undocked,
  119.     //remove bevelled edges
  120.     if ControlCount = 1 then
  121.       BevelEdges := []
  122. end;
  123.  
  124. procedure TForm1.ToolBar1StartDock(Sender: TObject;
  125.   var DragObject: TDragDockObject);
  126. begin
  127.   DragObject := TToolDockObject.Create(ToolBar1);
  128.   CustomDockObject := DragObject
  129. end;
  130.  
  131. procedure TForm1.ToolBar1EndDock(Sender, Target: TObject; X, Y: Integer);
  132. begin
  133.   CustomDockObject.Free;
  134.   CustomDockObject := nil
  135. end;
  136.  
  137. end.
  138.